home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
MATH
/
MAT
/
MATRIX.PAS
next >
Wrap
Pascal/Delphi Source File
|
1994-07-20
|
3KB
|
192 lines
Unit Matrix;
Interface
type
prow=^trow;
trow=array[1..801] of real;
psquare=^tsquare;
tsquare=array[1..800] of prow;
type
Pmatrix=^Tmatrix;
Tmatrix=object
rowcolumn:integer;
m,n:psquare;
s:array[1..800] of real;
constructor init;
procedure load(row,column:integer;value:real);
procedure solve(var solution;count:integer);
function check:real;
destructor done;
end;
Implementation
constructor tmatrix.init;
var
b,b1,b2,b3,b4,b5:integer;
begin
new(m);
for b:=1 to 800 do
begin
new(m^[b]);
end;
new(n);
for b:=1 to 800 do
begin
new(n^[b]);
end;
for b:=1 to 800 do
begin
for b1:=1 to 801 do
begin
m^[b]^[b1]:=0;
n^[b]^[b1]:=0;
end;
end;
end;
procedure tmatrix.load(row,column:integer;value:real);
begin
m^[row]^[column]:=value;
n^[row]^[column]:=value;
end;
procedure tmatrix.solve(var solution;count:integer);
label 1,2,3,4,5,6;
type
s1=array[1..800] of real;
var
irow,i,ii,j,jm1,k,ip1,im1,l,nn:integer;
big,ab,temp,sum:real;
begin
rowcolumn:=count;
irow:=1;
big:=abs(m^[1]^[1]);
for i:=2 to rowcolumn do
begin
ab:=abs(m^[i]^[1]);
if (big<ab) then
begin
big:=ab;
irow:=i;
end;
end;
if (irow<>1) then
begin
for j:=1 to (rowcolumn+1) do
begin
temp:=m^[irow]^[j];
m^[irow]^[j]:=m^[1]^[j];
m^[1]^[j]:=temp;
end;
end;
for j:=2 to (rowcolumn+1) do
begin
m^[1]^[j]:=m^[1]^[j]/m^[1]^[1];
end;
for i:=2 to rowcolumn do
begin
j:=i;
for ii:=j to rowcolumn do
begin
sum:=0;
jm1:=j-1;
for k:=1 to jm1 do
begin
sum:=sum+(m^[ii]^[k]*m^[k]^[j]);
end;
m^[ii]^[j]:=m^[ii]^[j]-sum;
end;
if (i<>rowcolumn) then
begin
irow:=i;
big:=abs(m^[i]^[i]);
ip1:=i+1;
for ii:=ip1 to rowcolumn do
begin
ab:=abs(m^[ii]^[i]);
if (big<ab) then
begin
big:=ab;
irow:=ii;
end;
end;
if (irow<>i) then
begin
for j:=1 to (rowcolumn+1) do
begin
temp:=m^[irow]^[j];
m^[irow]^[j]:=m^[i]^[j];
m^[i]^[j]:=temp;
end;
end;
end;
ip1:=i+1;
for j:=ip1 to (rowcolumn+1) do
begin
sum:=0;
im1:=i-1;
for k:=1 to im1 do
begin
sum:=sum+(m^[i]^[k]*m^[k]^[j]);
end;
m^[i]^[j]:=(m^[i]^[j]-sum)/m^[i]^[i];
end;
end;
s1(solution)[rowcolumn]:=m^[rowcolumn]^[(rowcolumn+1)];
l:=rowcolumn-1;
for nn:=1 to l do
begin
sum:=0;
i:=rowcolumn-nn;
ip1:=i+1;
for j:=ip1 to rowcolumn do
begin
temp:=s1(solution)[j];
sum:=sum+(m^[i]^[j]*temp);
end;
s1(solution)[i]:=m^[i]^[(rowcolumn+1)]-sum;
end;
for ii:=1 to rowcolumn do
begin
s[ii]:=s1(solution)[ii];
end;
end;
function tmatrix.check:real;
var
b,b1:integer;
sum,sum1:real;
begin
sum:=0;
sum1:=0;
for b:=1 to rowcolumn do
begin
for b1:=1 to rowcolumn do
begin
sum:=sum+(n^[b]^[b1]*s[b1]);
end;
sum1:=sum1+(sum-n^[b]^[(rowcolumn+1)]);
sum:=0;
end;
check:=sum1;
end;
destructor tmatrix.done;
var
b,b1:integer;
begin
for b:=1 to 800 do
begin
dispose(m^[b]);
end;
dispose(m);
for b:=1 to 800 do
begin
dispose(n^[b]);
end;
dispose(n);
end;
end.